home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #034 (19xx)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #034 (19xx)(Amiga User Group Deutschland e.V.).adf / Würfel_Poker / WürfelPoker (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-08-11  |  9KB  |  430 lines
  1. SCREEN 2,640,220,3,2
  2. WINDOW 2," Robert Braunrath presents:    Würfelpoker --- This is PD-Enjoy",,0,2
  3. PRINT
  4. LINE (1,1)-(20,10),,bf
  5. PALETTE 3,0.3,0.7,0  'gruen
  6. PALETTE 4,0.8,0,0.53 'rot
  7. DIM a1(36),a2(36),a3(36),a4(36),a5(36),a6(36),score(4,10),feld#(1250),score%(14),nam$(14)
  8. GOSUB Aufbauas
  9. GOSUB aufbau10
  10. GOSUB aufbau9
  11. GOSUB aufbauk
  12. GOSUB aufbaub
  13. GOSUB aufbaud
  14. PRINT:INPUT "   Anzahl der Mitspieler (2-4): ",zahl%
  15. CLS
  16. FOR i%=1 TO zahl%
  17.   PRINT:PRINT"Spieler " i%;
  18.   INPUT": ",spieler$(i%)
  19. NEXT  
  20. CLS
  21. LINE (64,16)-(zahl%*64+64,16)
  22. FOR i%=1 TO 6
  23.   READ A$:LOCATE i%*2+2,1:PRINT A$
  24.   LINE (64,i%*16+16)-(zahl%*64+64,i%*16+16)  
  25. NEXT
  26. LINE (5,113)-(zahl%*64+64,113)
  27. FOR i%=1 TO 4
  28.   READ A$:LOCATE i%*2+14,1:PRINT A$
  29.   LINE (64,i%*16+113)-(zahl%*64+64,i%*16+113)
  30. NEXT
  31. READ A$:LOCATE 24,1:PRINT A$
  32. LINE (64,178)-(zahl%*64+64,178)
  33. LINE (64,194)-(zahl%*64+64,194),2
  34. LINE (64,195)-(zahl%*64+64,195),2
  35. FOR i%=1 TO zahl%+1
  36.   LOCATE 2,8*i%+2:PRINT spieler$(i%);
  37.   LINE (64+(i%-1)*64,3)-(64+(i%-1)*64,193)
  38. NEXT
  39. DATA "   9","   10","   B","   D","   K","   As"
  40. DATA "  Str","  Full","  Poker","   Gr","  Total"
  41.  
  42. LINE (400,10)-(400,50)
  43. RANDOMIZE TIMER
  44. FOR i%=1 TO 10
  45.   FOR v%=1 TO zahl%
  46.     score(v%,i%)=77
  47.   NEXT
  48. NEXT  
  49. LINE (360,45)-(620,175),0,bf
  50. CIRCLE (490,110),110,3,,,0.5 'Der letzte Wert der Kreisanweisungen muß eventuell geändert werden, um bei jeder Bildschirmeinstellung einen runden Kreis zu erhalten
  51. PAINT (490,110),3
  52. CIRCLE (490,110),110,2,,,0.5
  53. CIRCLE (490,110),130,2,,,0.5
  54. PAINT (610,110),2 
  55. GET (380,55)-(600,165),feld#
  56. FOR z%=1 TO 10
  57.  FOR v%=1 TO zahl%
  58.    COLOR 3,0
  59.    LOCATE 2,8*v%+2:PRINT spieler$(v%);
  60.    COLOR 1,0
  61.    wo%=v%-1:IF v%=1 THEN wo%=zahl%
  62.    LOCATE 2,8*wo%+2:PRINT spieler$(wo%);
  63.    FOR e%=1 TO 5
  64.      weg%(e%)=e%   
  65.    NEXT  
  66.       FOR f%=1 TO 3
  67.         m%=0
  68.         PUT (380,55),feld#,PSET
  69.         FOR i%=1 TO 5
  70. s1:
  71.           FOR ee%=1 TO 5
  72.             IF weg%(ee%)=i% THEN     
  73.             merk%=1
  74.             w%(i%)=INT(RND*6+0.5)
  75.             END IF
  76.           NEXT         
  77.           IF w%(i%)=0 THEN GOTO s1
  78. s:
  79.           x%(i%)=RND*550
  80.           y%(i%)=RND*145       
  81.           IF x%(i%)<420 OR y%(i%)<75 THEN GOTO s
  82.           FOR g%=1 TO i%-1          
  83.             IF ABS(x%(i%)-x%(g%))<20 AND ABS(y%(i%)-y%(g%))<10 THEN GOTO s            
  84.           NEXT          
  85.           IF merk%=1 THEN ON w%(i%) GOSUB Neuner, Zehner, Bube, Dame, Koenig, Ass:m%=m%+1          
  86.           merk%=0
  87.         NEXT
  88.         FOR tt%=1 TO 5
  89.           weg%(tt%)=0
  90.         NEXT  
  91.         IF f%=3 THEN LOCATE 24,46:PRINT"Was darf`s sein, " spieler$(v%) "?"        
  92.         IF f%<3 THEN
  93.          LOCATE 24,46:PRINT"Was soll wieder in den Becher?";
  94.          LOCATE 25,46:PRINT"Nichts ?? => links klicken";
  95.          IF f%=2 THEN
  96.           IF e%=0 OR e%=5 THEN serv%=1
  97.          END IF
  98.         e%=0
  99.         MOUSE ON
  100.         xx%=450
  101.        WHILE xx%>400
  102.          MOUSE ON
  103.          WHILE merkmal%<>1
  104.            ON MOUSE GOSUB Maus   
  105.          WEND
  106.         LINE (360,184)-(600,200),0,bf       
  107.         merkmal%=0
  108.         IF xx%>429 AND xx%<571 THEN
  109.         e%=e%+1
  110.         weg%(e%)=INT((((xx%-400)/30)-0.3)+0.5)
  111.         FOR h%=1 TO e%-1         
  112.           IF weg%(e%)=weg%(h%) THEN
  113.             i%=weg%(e%)
  114.             merkmal1=1
  115.             ON w%(weg%(e%)) GOSUB Neuner, Zehner, Bube, Dame, Koenig, Ass
  116.             weg%(e%)=0
  117.             e%=e%-1                  
  118.             FOR j%=h% TO e%
  119.                weg%(j%)=weg%(j%+1)              
  120.             NEXT   
  121.           e%=e%-1:GOTO x                  
  122.           END IF   
  123.         NEXT
  124. x:
  125.         IF merkmal1=0 THEN
  126.           LINE (400+weg%(e%)*30,20)-(420+weg%(e%)*30,30),0,bf
  127.           LINE (400+weg%(e%)*30,20)-(420+weg%(e%)*30,30),1,B
  128.         END IF
  129.         merkmal1=0
  130.         END IF
  131.        WEND
  132.        END IF
  133.      NEXT
  134.      FOR i%=1 TO 6
  135.        FOR c%=1 TO 5  
  136.          IF w%(c%)=i% THEN summe(i%)=summe(i%)+1
  137.        NEXT
  138.      NEXT 
  139. t:
  140.      MOUSE ON
  141.      WHILE merkmal%<>1
  142.        ON MOUSE GOSUB Maus   
  143.      WEND
  144.      merkmal%=0
  145.      IF xx%<370 THEN was%=INT((yy%-8)/16+0.5) :ELSE BEEP:GOTO t
  146.      IF m%=0 OR m%=5 THEN mm%=5 :ELSE mm%=0
  147.      IF score(v%,was%)<>77 THEN BEEP:GOTO t
  148.      IF was%<7 THEN
  149.        score(v%,was%)=summe(was%)*was%
  150.        LOCATE was%*2+2,3+8*v%:PRINT score(v%,was%)
  151.      END IF  
  152.      IF was%>6 THEN GOSUB check   
  153.      REM ** Full **
  154.      IF was%=8 THEN
  155.      IF s%=1 AND t%=2 THEN
  156.       IF m%=0 AND serv%=1 THEN score(v%,8)=35 :ELSE score(v%,8)=30
  157.       IF m%=5 THEN score(v%,8)=35
  158.      END IF
  159.      IF s%<>1 OR t%<>2 THEN score(v%,8)=0
  160.      LOCATE was%*2+2,3+8*v%:PRINT score(v%,was%)
  161.      END IF   
  162.      REM ** Poker **
  163.      IF was%=9 THEN
  164.        IF s%=4 THEN
  165.          IF m%=0 AND serv%=1 THEN score(v%,9)=45 :ELSE score(v%,9)=40
  166.          IF m%=5 THEN score(v%,9)=45         
  167.      END IF
  168.      IF s%<>4 THEN score(v%,9)=0  
  169.      LOCATE was%*2+2,3+8*v%:PRINT score(v%,was%)
  170.      END IF
  171.      REM ** Grande **
  172.      IF was%=10 THEN
  173.      IF s%=5 THEN
  174.       IF m%=0 AND serv%=1 THEN score(v%,10)=80 :ELSE score(v%,10)=50
  175.       IF m%=5 THEN score(v%,10)=80
  176.      END IF
  177.      IF s%<>5 THEN score(v%,10)=0
  178.      LOCATE was%*2+2,3+8*v%:PRINT score(v%,was%)
  179.      END IF   
  180.      REM ** Straße **
  181.      IF was%=7 THEN
  182.       IF t%=0 AND ABS(summe(1)-summe(6))=1 THEN
  183.       IF m%=0 AND serv%=1 THEN score(v%,7)=25 :ELSE score(v%,7)=20
  184.       IF m%=5 THEN score(v%,7)=25
  185.      END IF
  186.      IF t%<>0 THEN score(v%,7)=0
  187.      IF ABS(summe(1)-summe(6))<>1 THEN score(v%,7)=0
  188.      LOCATE was%*2+2,3+8*v%:PRINT score(v%,was%)
  189.      END IF    
  190.      GOSUB loesch           
  191.      serv%=0
  192.      gesscore(v%)=gesscore(v%)+score(v%,was%)
  193.    NEXT
  194. NEXT  
  195. COLOR 3,0
  196. max=gesscore(1)
  197. winner%=1
  198. FOR v%=1 TO zahl%
  199.   LOCATE 24,3+8*v%:PRINT gesscore(v%)
  200.   IF gesscore(v%)>max THEN max=gesscore(v%):winner%=v%
  201. NEXT  
  202. LOCATE 24,46:INPUT"Bitte drücken Sie `Return`",t
  203. CLS
  204. COLOR 1,0
  205. PRINT:PRINT:PRINT:PRINT TAB(10) "THE WINNER IS ..............."
  206. LOCATE 20,10:PRINT "Bitte `h` für Speichern der Punkte und  Highscores drücken"
  207. COLOR 3,0
  208. WHILE INKEY$<>"h"
  209.   COLOR 3,0:LOCATE 7,20:PRINT spieler$(winner%)
  210.   COLOR 0,0:LOCATE 7,20:PRINT spieler$(winner%);
  211.   SOUND 6000*RND,2
  212. WEND
  213. ON ERROR GOTO Fehler
  214. OPEN "Topscorers" FOR INPUT AS 1
  215. WHILE NOT EOF(1)
  216.   in%=in%+1
  217.   INPUT #1,score%(in%),nam$(in%)
  218. WEND
  219. FOR ver%=1 TO v%
  220.   score%(in%+ver%)=gesscore(ver%)
  221.   nam$(in%+ver%)=spieler$(ver%)
  222. NEXT
  223. CLOSE
  224. OPEN "topscorers" FOR OUTPUT AS 1
  225. REM *** Ripple-Sort
  226. scha%=1
  227. WHILE scha%<>0
  228.   scha%=0
  229.   FOR verg%=1 TO in%+ver%-1
  230.     IF score%(verg%)<score%(verg%+1) THEN SWAP score%(verg%),score%(verg%+1):SWAP nam$(verg%),nam$(verg%+1):scha%=1
  231.   NEXT
  232. WEND
  233. CLS
  234. PRINT:PRINT
  235. LINE (0,13)-(630,27),2,bf
  236. LINE (0,31)-(630,41),2,bf
  237. COLOR 1,2
  238. PRINT "  The Topscorers"
  239. PRINT:PRINT TAB(70) "are:"
  240. FOR sc%=1 TO 70
  241.  SCROLL (0,13)-(500,27),3,0
  242.  SCROLL (0,32)-(630,40),-4,0
  243. NEXT
  244. PRINT
  245. COLOR 1,0
  246. FOR ver%=1 TO 10
  247.    PRINT TAB (20) nam$(ver%),score%(ver%)
  248.    WRITE #1,score%(ver%),nam$(ver%)
  249. NEXT  
  250. CLOSE
  251. END
  252.  
  253. Fehler:
  254. ko%=ERR
  255. IF ko%=53 THEN
  256.   CLOSE
  257.   OPEN "topscorers" FOR OUTPUT AS 1
  258.   nam$="---":score%=0
  259.   WRITE #1,score%,nam$
  260.   CLOSE
  261. END IF
  262. WINDOW 2
  263. RESUME   
  264.  
  265. Aufbauas:
  266. LINE (0,1)-(20,10),2,bf
  267. LINE (0,9)-(20,10),,bf
  268. CIRCLE (20,4),10
  269. PAINT (20,3)
  270. CIRCLE (1,4),10
  271. PAINT (1,5)
  272. LINE (0,0)-(1,1),0,bf:LINE (20,0)-(40,10),0,bf:LINE (0,0)-(1,10),1,bf
  273. LINE (10,7)-(10,4),2
  274. CIRCLE (10,3),2.5,2,,,0.5:PAINT (10,3),2
  275. CIRCLE (14,5),2.5,2,,,0.5:PAINT (14,5),2
  276. CIRCLE (6,5),2.5,2,,,0.5:PAINT (6,5),2
  277. LINE (3,0)-(18,1),1,bf
  278. LINE (20,0)-(21,10),1,bf
  279. GET (0,0)-(20,10),a6
  280. CLS
  281. RETURN
  282.  
  283. aufbau10:
  284. COLOR 4,0
  285. LINE (0,0)-(20,10),1,bf
  286. B%=2
  287. FOR A%=1 TO 2
  288.  FOR i%=1 TO 4
  289.   AREA ((i%-1)*4+3,B%)
  290.   AREA ((i%-1)*4+4,B%-1)
  291.   AREA ((i%-1)*4+4,B%+1)
  292.   AREA ((i%-1)*4+5,B%)
  293.   AREAFILL
  294.  NEXT
  295.  B%=8
  296. NEXT
  297. AREA (6,5)
  298. AREA (7,4)
  299. AREA (7,6)
  300. AREA (8,5)
  301. AREAFILL
  302. AREA (14,5)
  303. AREA (15,4)
  304. AREA (15,6)
  305. AREA (16,5)
  306. AREAFILL
  307. GET (0,0)-(20,10),a2
  308. COLOR 2,0
  309. CLS
  310. RETURN
  311.  
  312. aufbau9:
  313. LINE (0,0)-(20,10),1,bf
  314. B%=2
  315. FOR A%=1 TO 2
  316.  FOR i%=1 TO 4
  317.   CIRCLE ((i%-1)*4+4,B%),2.5:PAINT ((i%-1)*4+4,B%)
  318.  NEXT
  319.  B%=8
  320. NEXT
  321. CIRCLE (10,5),2.5:PAINT (10,5)
  322. GET (0,0)-(20,10),a1
  323. COLOR 1,0
  324. CLS
  325. RETURN
  326.  
  327. aufbauk:
  328. LINE (0,0)-(20,10),1,bf
  329. COLOR 4,0
  330. LINE (3,3)-(3,9)
  331. LINE -(17,9)
  332. LINE -(17,3)
  333. LINE -(14,6)
  334. LINE -(10,3)
  335. LINE -(6,6)
  336. LINE -(3,3)
  337. PAINT (10,5)
  338. GET (0,0)-(20,10),a5
  339. CLS
  340. COLOR 2,0
  341. RETURN
  342.  
  343. aufbaub: 
  344. LINE (0,0)-(20,10),1,bf
  345. LINE (2,4)-(16,4)
  346. LINE -(9,9)
  347. LINE -(2,4)
  348. CIRCLE (9.5,3),1.5,,,,0.7
  349. LINE (6,4)-(11,8)
  350. CIRCLE (17,5),1
  351. LINE (17,1.5)-(17,9)
  352. PAINT (6,5)
  353. CIRCLE (1.5,5),1
  354. LINE (16.5,2)-(17.5,2)
  355. GET (0,0)-(20,10),a3
  356. COLOR 0,0
  357. CLS
  358. RETURN
  359.  
  360. aufbaud:
  361. LINE (0,0)-(20,10),1,bf
  362. LINE (8,4)-(4,9)
  363. LINE -(16,9)
  364. LINE -(12,4)
  365. LINE -(8,4)
  366. CIRCLE (10,2.5),1.5,,,,0.6
  367. CIRCLE (7,6),1
  368. CIRCLE (13,6),1
  369. LINE (15,8)-(5,8)
  370. GET (0,0)-(20,10),a4
  371. COLOR 1,0
  372. CLS
  373. RETURN
  374.  
  375. Neuner:
  376. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a1,PSET
  377. PUT (400+i%*30,20),a1,PSET
  378. RETURN
  379.  
  380. Zehner:
  381. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a2,PSET
  382. PUT (400+i%*30,20),a2,PSET
  383. RETURN
  384.  
  385. Bube:
  386. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a3,PSET
  387. PUT (400+i%*30,20),a3,PSET
  388. RETURN
  389.  
  390. Dame:
  391. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a4,PSET
  392. PUT (400+i%*30,20),a4,PSET
  393. RETURN
  394.  
  395. Koenig:
  396. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a5,PSET
  397. PUT (400+i%*30,20),a5,PSET
  398. RETURN
  399.  
  400. Ass:
  401. IF merkmal1<>1 THEN PUT (x%(i%),y%(i%)),a6,PSET
  402. PUT (400+i%*30,20),a6,PSET
  403. RETURN
  404.  
  405. Maus:
  406. u%=MOUSE(0)
  407. xx%=MOUSE(3)
  408. yy%=MOUSE(4)
  409. merkmal%=1
  410. MOUSE OFF
  411. RETURN
  412.  
  413. check:
  414. FOR i%=1 TO 6
  415.   IF summe(i%)>2 THEN s%=1
  416.   IF summe(i%)>1 THEN t%=t%+1
  417.   IF summe(i%)=4 THEN s%=4
  418.   IF summe(i%)=5 THEN s%=5
  419. NEXT
  420. RETURN
  421.  
  422. loesch:
  423. s%=0:t%=0
  424. FOR i%=1 TO 6
  425.  summe(i%)=0
  426. NEXT 
  427. e%=0
  428. RETURN
  429.  
  430.